perm filename BIN[G,BGB]3 blob
sn#066970 filedate 1974-01-02 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00021 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 TITLE BIN BODY INTERSECTION - 7 MARCH 1973.
C00005 00003 comment/
C00008 00004 SUBR(WITH3D)FACE,XWC,YWC,ZWC TEST FOR LOCUS WITHIN FACE 3D.
C00011 00005 SUBR(COMPFE)FACE,EDGE COMPARE FACE EDGE 3D FOR PIERCING.
C00014 00006 SUBR(VNEXT)F,E.,V
C00016 00007 SUBR(OTHERV)F,V1
C00018 00008 SUBR(BTRACE)V0 TRACE THE BODY OF INTERSECTION STARTING FROM V0.
C00020 00009 L1:
C00022 00010 SUBR(FTRACE)F. FACE TRACE.
C00024 00011 MAKE WASP FACE.
C00025 00012 SUBR(BIN,B1,B2) COMPUTE BODY OF INTERSECTION.
C00028 00013 SUBR(SOLANG)V SOLID ANGLE OF A SURFACE VERTEX.
C00030 00014 SUBR(KLSURV)B KILL SURFACE VERTICES OF A BODY.
C00033 00015 SUBR(QHOLE)V DETECT AND PYRAMID POTENTIAL PIERCE HOLES.
C00035 00016 SUBR(BUN)B1,B2 BODY UNION.
C00036 00017 SUBR(MKCVEX)F MAKE CONVEX.
C00038 00018 GO L6
C00040 00019 SCAN FACE1'S PERIMETER VERT1 TO VERT3.
C00042 00020 SUBR(ESLURP,BODY) REMOVE UNNECESSARY EDGES.
C00045 00021 DIAGONOSTIC DISPLAY.
C00046 ENDMK
C⊗;
TITLE BIN BODY INTERSECTION - 7 MARCH 1973.
EXTERN VCW,VCCW,ECCW,VERIFY
EXTERN FACOEF,ESPLIT,INVERT
EXTERN GLUEE,LINKED,MKEV,MKFE
EXTERN MKB,MKF,MKV,MKFRAME
EXTERN OTHER,EVERT,FCCW,FCW
EXTERN DPYBUF,DPYSET,DPYOUT
EXTERN FDPY,EDPY,VDPY
EXTERN QFEV,KLFE,ECOEF,ECW
↓SURBIT←←1B2 ;VERTEX ON SURFACE.
↓OKBIT←←2B2
DEFINE QFACE(Q,V){CDR Q,7(V)}
DEFINE QFACE.(Q,V){DAP Q,7(V)}
DEFINE NAF (Q,E){CAR Q,-1(E)}
DEFINE NAF.(Q,E){DIP Q,-1(E)}
DEFINE PAF (Q,E){CDR Q,-1(E)}
DEFINE PAF.(Q,E){DAP Q,-1(E)}
DEFINE JALT(A,B){ALT. A,B↔ALT. B,A}
DEFINE JALTV(V,V.){ALT. V,V.↔ALT. V.,V
SLACI XWC(V)↔LAPI XWC(V.)↔BLT ZWC(V.)}
DECLARE{FNEXT,ENEXT}
comment/
Although this code performs body union and body subtraction;
all the nomensclature will be in terms of body intersection, BIN.
Pure BIN takes two operand bodies and "copies" off them a resultant
body of their intersection. This requires marking and splitting some
of faces and edges, however the operand bodies can be restored to
their original selves by applying KLTMPS; or if the operands are no
longer needed they must be explicitly killed.
1. Face-Edge Compare; Make piercing vertices.
All the faces of each operand is compared with all the edges
of the other. When a edge passes thru a face, the edge is spilt and
a "surface vertex" or "SURV" is placed at the piercing point. The
QFACE of the SURV points at the face pierce.
2. Face Hole Suppression.
3. Body and Face Tracing.
4. Dealing with bodies of parts.
5. Convex face making.
LINKS LEFT BY BIN.
ALT of all result vertices points to a vertex in one or the
other operand. ALT of a result edge is zero, if the edge was formed
by two conflicting faces in the operands, the particular faces are
pointed at by the NAF and PAF links. A non-zero ALT of a result edge,
points at an edge of one operand that was buried inside the solid
body of the other operand, and is thus called an interior edge.
ALT of all faces of the result points at the corresponding face of
one of the operands.
/
SUBR(WITH3D)FACE,XWC,YWC,ZWC; TEST FOR LOCUS WITHIN FACE 3D.
COMMENT ⊗------------------------------------------------------------
⊗
ACCUMULATORS{FLG,V,E,F,DX1,DY1,DZ1,Q1,DX2,DY2,DZ2,Q2,E0}
;SELECT COMPONENT BY LARGEST FACE COEFFICIENT.
LAC F,ARG4
LACM 1,AA(F)
LACM 2,BB(F)
LACM 3,CC(F)
LACI C0↔CAMG 1,2↔GO[
LACI C1↔CAMG 2,3↔LACI C2↔GO .+3]
CAMG 1,3↔LACI C2↔DAP CASE
;FIRST EDGE OF THE FACE.
DOM FLG
PED E,F↔DAC E,E0↔SETQ(V,{VCW,E,F})
LAC DX2,XWC(V)↔FSB DX2,ARG3
LAC DY2,YWC(V)↔FSB DY2,ARG2
LAC DZ2,ZWC(V)↔FSB DZ2,ARG1
L1: LAC DX1,DX2
LAC DY1,DY2
LAC DZ1,DZ2
LAC Q1,Q2
;NEXT EDGE OF THE FACE.
SETQ(V,{VCCW,E,F})
SETQ(E,{ECCW,E,F})
LAC DX2,XWC(V)↔FSB DX2,ARG3
LAC DY2,YWC(V)↔FSB DY2,ARG2
LAC DZ2,ZWC(V)↔FSB DZ2,ARG1
;COMPUTE A COMPONENT OF THE CROSS-PRODUCT.
CASE: GO
C0: LAC 0,DY2↔FMP 0,DZ1↔LAC 1,DY1↔FMP 1,DZ2↔GO C3
C1: LAC 0,DX1↔FMP 0,DZ2↔LAC 1,DX2↔FMP 1,DZ1↔GO C3
C2: LAC 0,DX2↔FMP 0,DY1↔LAC 1,DX1↔FMP 1,DY2
C3: FSB 0,1↔DAC Q2
JUMPE 0,L3 ;LOCUS IS ON A FUCKING EDGE !
;DETECT SIGN CHANGE.
AOJE FLG,L2 ;JUMP ON FIRST TIME THRU.
XOR Q1↔JUMPL POP4J. ;NO SKIP RETURN FALSE.
L2: CAME E,E0↔GO L1
AOS(P)↔POP4J ;SKIP RETURN TRUE - LOCUS IS WITHIN.
L3: LAC DX1↔FMP DX2 ;COSINE.
LAC 1,DY1↔FMP 1,DY2↔FAD 0,1
LAC 1,DZ1↔FMP 1,DZ2↔FAD 0,1
SKIPGE↔AOS(P)↔POP4J ;SKIP RETURN TRUE - LOCUS IS WITHIN.
ENDR WITH3D;3/7/73(BGB)----------------------------------------------
SUBR(COMPFE)FACE,EDGE ;COMPARE FACE EDGE 3D FOR PIERCING.
COMMENT .------------------------------------------------------------
V2 ← PVT ⊗ Q2 < K ABOVE F,
| ENEW
____|_____________________
/ | /
/ ⊗ V FACE F /
/_________________________/
|
| E
V1 ← NVT ⊗ Q1 > K BELOW-F.
ACCUMULATORS{X,Y,Z,V1,V2,E,F}
;CHECK ARGUMENTS FOR FRESHNESS.
LAC E,ARG1↔LAC F,ARG2
NVT V1,E↔PVT V2,E
QFACE 1,V1↔CAMN 1,F↔POP0J
QFACE 1,V2↔CAMN 1,F↔POP0J
;DIRECTED DISTANCE V1 FROM FACE.
LAC 0,AA(F)↔FMP 0,XWC(V1)
LAC 1,BB(F)↔FMP 1,YWC(V1)↔FAD 0,1
LAC 1,CC(F)↔FMP 1,ZWC(V1)↔FAD 0,1↔DAC Q1#
;DIRECTED DISTANCE V2 FROM FACE.
LAC 0,AA(F)↔FMP 0,XWC(V2)
LAC 1,BB(F)↔FMP 1,YWC(V2)↔FAD 0,1
LAC 1,CC(F)↔FMP 1,ZWC(V2)↔FAD 0,1↔DAC Q2#
;DOES EDGE PASS THRU THE PLANE OF THIS FACE.
LAC KK(F)
CAMG Q1↔GO .+3↔CAMLE Q2↔POP0J
CAML Q1↔GO .+3↔CAMGE Q2↔POP0J
FSB 0,Q1↔LAC 1,Q2↔FSB 1,Q1
FDVR 0,1↔SKIPL↔CAMLE[1.0]↔POP0J↔DAC 1
;SOLVE FOR PLANE PIERCING LOCUS.
LAC X,XWC(V1)↔LAC XWC(V2)↔FSB X↔FMP 1↔FADM X
LAC Y,YWC(V1)↔LAC YWC(V2)↔FSB Y↔FMP 1↔FADM Y
LAC Z,ZWC(V1)↔LAC ZWC(V2)↔FSB Z↔FMP 1↔FADM Z
CALL(WITH3D,F,X,Y,Z)↔POP0J
LAC E,ARG1↔LAC F,ARG2↔ADD P,[XWD 4,4]
;MAKE FACE PIERCING POINT.
LAC KK(F)↔CAMLE Q1↔GO[CALL(INVERT,E)↔GO .+1]
CALL(ESPLIT,E)↔MARK 1,SURBIT
POP P,ZWC(1)↔POP P,YWC(1)↔POP P,XWC(1)↔POP P,0
QFACE. 0,1↔LAC 2,ARG1↔PED. 2,1↔POP0J
ENDR COMPFE;3/7/73---------------------------------------------------
SUBR(VNEXT)F,E.,V
COMMENT ⊗------------------------------------------------------------
⊗↔ ACCUMULATORS{F,E.,V}
LAC F,ARG3
LAC E.,ARG2
LAC V,ARG1
;INTERIOR TO INTERIOR.
ALT 1,E.↔DAC 1,ENEXT
TEST V,SURBIT↔GO[ ;SKIP WHEN VERTEX ON SURFACE.
SETQ(ENEXT,{ECCW,ENEXT,F})
CALL(VCCW,ENEXT,F)↔POP3J]
;SURFACE TO INTERIOR.
QFACE 0,V↔DAC 0,FNEXT
CAME F,FNEXT↔JUMPE 1,[
PED 1,V↔DAC 1,ENEXT
CALL(OTHER,1,V)↔POP3J]
;INTERIOR TO SURFACE.
DZM ENEXT↔CAME F,FNEXT↔GO[
CALL(OTHERV,F,V)↔POP3J]
;SURFACE TO SURFACE.
PAF 1,E.↔CAMN 1,F↔NAF 1,E.
PED 0,V↔CALL(OTHER,0,1)↔DAC 1,FNEXT
CALL(OTHERV,FNEXT,V)↔POP3J
ENDR VNEXT;3/8/73(BGB)-----------------------------------------------
SUBR(OTHERV)F,V1
COMMENT; OTHER PIERCING VERTEX MANDALA
F1 PIERCES F2 AT V2 CASE. F2 PIERCES F1 AT V2 CASE.
______________ ________
| | | |
| F2 | | F2 |
______|......... | ______|........|_____
| ↓ . | | ↓ ↓ |
| F1 ⊗V1 ⊗V2 | | F1 ⊗V1 ⊗V2 |
|_______________↑ | |_____________________|
| | | |
|______________| |________| ;
ACCUMULATORS{F1,F2,V1,E,E0}
LAC F2,ARG2
LAC V1,ARG1
QFACE F1,V1
;DOES F1 PIERCE F2 AT V2.
PED E,F1↔DAC E,E0
L1: CALL(VCCW,E,F1)
QFACE 0,1
CAMN 0,F2↔POP2J
SETQ(E,{ECCW,E,F1})
CAME E,E0↔GO L1
;DOES F2 PIERCE F1 AT V2.
PED E,F2↔DAC E,E0
L2: CALL(VCCW,E,F2)
CAMN 1,V1↔GO .+4
QFACE 0,1
CAMN 0,F1↔POP2J
SETQ(E,{ECCW,E,F2})
CAME E,E0↔GO L2
FATAL(OTHERV)
ENDR OTHERV;3/8/73(BGB)----------------------------------------------
SUBR(BTRACE)V0 TRACE THE BODY OF INTERSECTION STARTING FROM V0.
COMMENT ⊗------------------------------------------------------------
⊗↔ GO L0
ACCUMULATORS{B,F,F.,E,E.,V,V.,V0}
DECLARE{BODYIN,FACE,FACE.,EDGE,EDGE.,VERT,VERT.,VERT0}
;MAKE THE BODY NODE.
L0: LAC 1,ARG1↔PED 1,1↔CCW 1,1 ;BODY OF V0.
SETQ(BODYIN,{MKB,1})
CALL(MKF,BODYIN)
CALL(MKV,BODYIN)
CALL(MKFRAME)
LAC B,BODYIN
FRAME. 1,B
;FIRST EDGE OF THE BODY AND ALL ITS FRIENDS.
LAC V0,ARG1
PVT V.,B
JALTV(V0,V.)
PED E,V0
SETQ(F,{FCCW,E,V0})
PFACE F.,B
JALT(F,F.)
SETQ(V,{VCCW,E,F})
LAC[XWD B,BODYIN]↔BLT VERT0 ;SAVE AC'S.
SETQ(V.,{MKEV,F.,V.})↔DAC V.,VERT.
LAC V,VERT↔LAC E,EDGE
JALTV(V,V.)
PED E.,V.↔DAC E.,EDGE.
JALT(E,E.)
CAR(E)↔DIP(E.) ;MOVE TYPE BITS. **
L1:
SETQ(VERT,{VNEXT,FACE,EDGE.,VERT})
CAME 1,VERT0↔GO L2
;LAST VERTEX OF THE LAMINA.
ALT 1,1↔SETQ(EDGE.,{MKFE,1,FACE.,VERT.})
LAC E.,EDGE.
SKIPE 1,ENEXT
GO[
JALT(1,E.)
CAR(1)↔DIP(E.); **
NFACE F.,E.↔DAC F.,FACE.↔GO L3]
LAC 1,FNEXT↔PAF. 1,E.
LAC F,FACE↔NAF. F,E.
NFACE F.,E.↔DAC F.,FACE.↔GO L3
;NEXT VERTEX OF THE LAMINA.
L2: SETQ(VERT.,{MKEV,FACE.,VERT.})
LAC V,VERT↔JALTV(V,1)
PED E.,1↔DAC E.,EDGE.
SKIPE 1,ENEXT
GO[JALT(1,E.)
CAR(1)↔DIP(E.); **
GO L1]
LAC F,FACE↔PAF. F,E.
LAC 1,FNEXT↔NAF. 1,E.
GO L1
L3: CALL(EVERT,BODYIN)
;TRACE OUT ALL THE FACES CONNECTED TO THIS BODY.
L4: LAC 1,FACE.
TEST 1,FBIT
GO[LAC 1,BODYIN↔POP1J] ;RETURN THE BODY.
CALL(FTRACE,FACE.)
LAC 1,FACE.
PFACE 1,1
DAC 1,FACE.
GO L4
ENDR BTRACE;3/8/73(BGB)----------------------------------------------
SUBR(FTRACE)F. FACE TRACE.
COMMENT ⊗------------------------------------------------------------
⊗↔ GO L0
DECLARE{F,F.,E,E.,V,V.,U,U.,V0,F2.}
;GET THE FIRST EDGE AND ITS FRIENDS.
L0: LAC 1,ARG1↔DAC 1,F.
PED 1,1↔DAC 1,E.
CALL(VCW,E.,F.)↔ALT 1,1↔DAC 1,V0
CALL(VCCW,E.,F.)↔ALT 1,1↔DAC 1,V
LAC 2,E.↔ALT 1,2↔DAC 1,E
JUMPN 1,[
CALL(OTHER,E.,F.)
ALT 1,1
CALL(OTHER,E,1)
GO .+5]
PAF 1,2↔PFACE 0,2
CAME 0,F.↔NAF 1,2
DAC 1,F↔LAC 2,F.
JALT(1,2)
L1:
LAC 1,V↔CAMN 1,V0↔POP1J ;EXIT.
DAC 1,U
SETQ(V,{VNEXT,F,E.,V})
SETQ(E.,{ECCW,E.,F.})
SETQ(V.,{VCCW,E.,F.})
;MAKE SPUR.
LAC 1,V↔ALT 1,1↔JUMPN 1,L2
LAC 1,U↔ALT 1,1
SETQ(V.,{MKEV,F.,1})
LAC 2,V↔JALTV(2,1)
PED 1,1↔DAC 1,E.
SKIPE 2,ENEXT↔GO[JALT(2,1)↔GO L1]
LAC 2,FNEXT↔NAF. 2,1
LAC 2,F↔PAF. 2,1↔GO L1
;SPLIT FACE.
L2: CAMN 1,V.↔GO L1 ;SKIP V.≠ALT(V).
CALL(LINKED,1,F.)
JUMPE 1,L3 ;JUMP WHEN NOT LINKED.
LAC 1,V↔ALT 1,1
LAC 2,U↔ALT 2,2
SETQ(E.,{MKFE,2,F.,1})
SKIPE 2,ENEXT↔GO[JALT(2,1)↔GO L1]
LAC 2,FNEXT↔NAF. 2,1
LAC 2,F↔PAF. 2,1↔GO L1
;MAKE WASP FACE.
L3: LAC 1,V↔ALT 1,1↔DAC 1,V.
LAC 1,U↔ALT 1,1↔DAC 1,U.
LAC 1,F.↔PFACE 1,1↔DAC 1,F2.
JUMPE 1,[FATAL({WASP LINK F2.=0.})]
SETQ(E.,{GLUEE,F.,U.,F2.,V.})
SKIPE 2,ENEXT↔GO[JALT(2,1)↔GO L1]
LAC 2,FNEXT↔PAF. 2,1
LAC 2,F↔NAF. 2,1
GO L1
ENDR FTRACE;3/8/73(BGB)----------------------------------------------
SUBR(BIN,B1,B2) COMPUTE BODY OF INTERSECTION.
COMMENT ⊗------------------------------------------------------------
⊗↔
LAC 1,B1↔TEST 1,BBIT↔POP2J↔CALL(FACOEF,1,[0])
LAC 1,B2↔TEST 1,BBIT↔POP2J↔CALL(FACOEF,1,[0])
LAC 1,B1↔PVT 1,1↔TEST 1,VBIT↔GO .+3↔DZM ZPP(1)↔GO .-5
LAC 1,B2↔PVT 1,1↔TEST 1,VBIT↔GO .+3↔DZM ZPP(1)↔GO .-5
;COMPARE ALL THE EDGES OF ONE WITH ALL THE FACES OF THE OTHER.
;THIS N SQUARED PROCESS MAY SOMEDAY BE REPLACED WITH AN OCCULT MODE.
LAC 1,B2
L1: PED 1,1↔TEST 1,EBIT↔GO L2-1
LAC 2,B1↔PFACE 2,2↔TESTZ 2,FBIT↔GO[
CALL(COMPFE,2,1)↔POP P,1↔POP P,2↔GO .-3]↔GO L1
LAC 1,B1
L2: PED 1,1↔TEST 1,EBIT↔GO L3
LAC 2,B2↔PFACE 2,2↔TESTZ 2,FBIT↔GO[
CALL(COMPFE,2,1)↔POP P,1↔POP P,2↔GO .-3]↔GO L2
L3: CALL(GETSURV,B1)↔GO L4
CALL(GETSURV,B2)↔GO L4
GO L5
L4: CALL(QHOLE,1) ;CHECK OUT A POTENTIAL HOLE.
GO L3 ;NO HOLE YET.
CALL(KLSURV,B1) ;HOLE FACE WAS PYRAMID'ED.
CALL(KLSURV,B2) ;START OVER.
GO BIN
L5: LAC 1,B1
NVT 1,1↔TESTZ 1,VBIT↔GO[
TEST 1,SURBIT↔GO .-3
ALT 0,1↔SKIPE↔GO .-3
CALL(BTRACE,1,1)
DAC 1,B#
POP P,1↔GO .-3]
LAC 1,B2
NVT 1,1↔TESTZ 1,VBIT↔GO[
TEST 1,SURBIT↔GO .-3
ALT 0,1↔SKIPE↔GO .-3
CALL(BTRACE,1,1)
POP P,1↔GO .-3]
LAC 1,B
POP2J
ENDR BIN;3/7/73(BGB)-------------------------------------------------
SUBR(SOLANG)V SOLID ANGLE OF A SURFACE VERTEX.
COMMENT ⊗------------------------------------------------------------
⊗↔ EXTERN ACOS,DISTANCE,TWOPI
ACCUMULATORS{F,V}
LAC 1,ARG1↔DAC 1,V0
PED 1,1↔DAC 1,E
SETQ(F1,{FCCW,E,V0})↔SETQ(V1,{OTHERV,F1,V0})
SETQ(F2,{FCW,E,V0})↔ SETQ(V2,{OTHERV,F2,V0})
CALL(DISTANCE,V1,V0)↔PUSH P,1 ;L1
CALL(DISTANCE,V2,V0)↔PUSH P,1 ;L2
CALL(DISTANCE,V1,V2)↔FMPR 1,1↔MOVNS 1 ;L3
;ANGLE ← ACOS((L1*L1 + L2*L2 - L3*L3)/(2*L1*L2)).
POP P,2↔POP P,3
LAC 2↔FMPR 3↔FSC 1
FMPR 2,2↔FMPR 3,3
FADR 1,2↔FADR 1,3
FDVR 1,0
CALL(ACOS,1)↔PUSH P,1
LAC V,V2↔LAC F,F1
LAC 0,XWC(V)↔FMPR 0,AA(F)
LAC 1,YWC(V)↔FMPR 1,BB(F)↔FADR 0,1
LAC 1,ZWC(V)↔FMPR 1,CC(F)↔FADR 0,1
POP P,1
CAML KK(F)↔POP1J↔MOVNS 1
FADR TWOPI↔POP1J ;REFLEX ANGLE.
DECLARE{V0,V1,V2,E,F1,F2}
ENDR SOLANG;3/23/73(BGB)---------------------------------------------
SUBR(KLSURV)B KILL SURFACE VERTICES OF A BODY.
COMMENT ⊗------------------------------------------------------------
⊗↔ ACCUMULATORS{V}
LAC V,ARG1
L: NVT V,V↔CAMN V,ARG1↔POP1J
TEST V,SURBIT↔GO L
NVT V,V↔PUSH P,V↔PVT V,V
CALL(KLEV↑,V)↔POP P,V
GO L+1
ENDR KLSURV;3/23/73(BGB)---------------------------------------------
SUBR(OKSURV)V MARK A SURFACE LOOP AND MAKE ITS LIST.
COMMENT ⊗------------------------------------------------------------
⊗↔ V←←2
LAC V,ARG1↔PED 1,V
PFACE 1,1↔DAC 1,FACE# ;FACE BEGLONG TO V.
QFACE 1,V↔DAC 1,OLDQF# ;FACE PIERCED BY V.
L: MARK V,OKBIT↔PUSH P,V
CALL(OTHERV,FACE,V) ;FOLLOW SURV LOOP ACROSS.
POP P,V
CAMN 1,ARG1↔GO[
SETZ↔ALT2. 0,V↔POP1J] ;NIL AT END OF LIST.
ALT2. 1,V↔DAC 1,V ;OLDE V POINTS AT NEW V.
QFACE 0,V↔LAC 1,FACE ;NEXT FACE.
CAME 0,OLDQF↔LAC 1,OLDQF
DAC 0,OLDQF↔PED 0,V
SETQ(FACE,{OTHER,0,1})
GO L
ENDR OKSURV;3/23/73(BGB)---------------------------------------------
SUBR(GETSURV)B GET AN UNMARKED SURFACE VERTEX OF A BODY OR SKIP.
COMMENT ⊗------------------------------------------------------------
⊗↔ LAC 1,ARG1
L: NVT 1,1
CAMN 1,ARG1
GO[AOS(P)↔POP1J]
TEST 1,SURBIT↔GO L
TESTZ 1,OKBIT↔GO L
POP1J
ENDR GETSURV;3/23/73(BGB)--------------------------------------------
SUBR(QHOLE)V DETECT AND PYRAMID POTENTIAL PIERCE HOLES.
COMMENT ⊗------------------------------------------------------------
⊗↔ EXTERN PYRAMID,PI
V←←2
CALL(OKSURV,ARG1)
;SECOND TIME AROUND - LOOK FOR DIFFERENT Q-FACES.
LAC V,ARG1
QFACE 1,V↔DAC 1,QF#
L1: ALT2 V,V↔JUMPE V,L2
QFACE 0,V↔CAME 0,QF↔POP1J ;EXIT NO HOLE.
GO L1
L2: DZM A#↔DZM N#↔DZM X#↔DZM Y#↔DZM Z#
;THIRD TIME AROUND - TAKE SUM OF SOLID INTERIOR ANGLES.
LAC V,ARG1
L3: LAC XWC(V)↔FADRM X
LAC YWC(V)↔FADRM Y
LAC ZWC(V)↔FADRM Z
AOS N↔PUSH P,V
CALL(SOLANG,V)↔FADRM 1,A
POP P,V↔ALT2 V,V
SKIPE V↔GO L3
LAC 0,N↔FLOAT↔DAC 0,N
FSBRI(2.0)↔FMPR PI↔FSBR A
L4: MOVMS↔CAMGE[0.01]↔POP1J ;EXIT - NO HOLE.
CALL(PYRAMID,QF)
LAC X↔FDVR N↔DAC XWC(1)
LAC Y↔FDVR N↔DAC YWC(1)
LAC Z↔FDVR N↔DAC ZWC(1)
PED 2,1↔DAC 2,3↔DAC 1,4
L5: MARK 2,DARKEN↔SETQ(2,{ECCW,2,4})↔CAME 2,3↔GO L5
AOS(P)↔POP1J ;SKIP EXIT - HOLE.
ENDR QHOLE;3/23/73(BGB)----------------------------------------------
SUBR(BUN)B1,B2 BODY UNION.
COMMENT ⊗------------------------------------------------------------
⊗↔ CALL(EVERT,ARG1)
CALL(EVERT,ARG2)
CALL(BIN,ARG2,ARG2)
PUSH P,1
CALL(EVERT,1)
POP P,1
POP2J
ENDR BUN;3/10/73(BGB)------------------------------------------------
SUBR(BSUB)B1,B2 BODY SUBTRACTION BNEW ← (B1-B2).
COMMENT ⊗------------------------------------------------------------
⊗↔ CALL(EVERT,ARG1)
CALL(BIN,ARG2,ARG2)
POP2J
ENDR BSUB;3/10/73(BGB)-----------------------------------------------
SUBR(MKCVEX)F MAKE CONVEX.
COMMENT ⊗------------------------------------------------------------
⊗↔ EXTERN MKFE,KLFE,ECOEF,VCCW,QFEV,ECW
ACCUMULATORS{F,E0,V,CNT,N,S,E,W,YMAX,YMIN,XMAX,XMIN}
;GET EXTREMA VERTICES.
MKCVX.:
LAC F,ARG1↔DAC F,FACE1
TEST F,BBIT↔GO L0
L00: PFACE F,F↔CAMN F,ARG1↔POP1J
PUSH P,F↔CALL(MKCVEX,F)↔POP P,F↔GO L00
L0: PED E0,F↔DAC E0,EDGE0
LACI CNT,1
SLACI YMAX,400000
SLACI XMAX,400000
SETCM YMIN,YMAX
SETCM XMIN,XMAX
L1: SETQ(V,{VCCW,E0,F})
CAMGE YMAX,YPP(V)↔GO[LAC YMAX,YPP(V)↔LAC N,V↔GO .+1]
CAMGE XMAX,XPP(V)↔GO[LAC XMAX,XPP(V)↔LAC E,V↔GO .+1]
CAMLE YMIN,YPP(V)↔GO[LAC YMIN,YPP(V)↔LAC S,V↔GO .+1]
CAMLE XMIN,XPP(V)↔GO[LAC XMIN,XPP(V)↔LAC W,V↔GO .+1]
SETQ(E0,{ECCW,E0,F})
CAME E0,EDGE0↔AOJA CNT,L1
;EXIT IF FACE1 IS ALREADY A TRIANGLE (OR LESS).
L1B: CAIG CNT,3↔POP1J
GO L6
;--------------------------------------------------------------------
;LOP OFF THE POINT WITH THE SMALLEST ANGLE ≡ LARGEST COSINE.
L5:
LAC V,ARG1↔DAC V,VERT2
SETQ(EDGE1,{ECCW,VERT2,FACE1})
PVT 0,1↔CAMN 0,V↔GO .+3
CALL(INVERT,1)↔NVT 0,1↔DAC VERT3
SETQ(EDGE3,{ECW,VERT2,FACE1})
PVT 0,1↔CAMN 0,V↔GO .+3
CALL(INVERT,1)↔NVT 0,1↔DAC VERT1
CALL(ECOEF,EDGE1)
CALL(ECOEF,EDGE3)
LAC 2,EDGE1↔LAC 3,EDGE3
LAC 1,AA(2)↔FMPR 1,AA(3)
LAC 0,BB(2)↔FMPR 0,BB(3)↔FADR 1,0
LAC 0,ARG1
SUB P,[2(2)]↔GO @2(P) ;"POP1J"
;--------------------------------------------------------------------
L6: CALL(,N,S,E,W)
SLACI(<-2.0>)↔DAC TMP
CALL(L5)↔CAMGE 1,TMP↔GO .+3↔DAC VERT0↔DAC 1,TMP
CALL(L5)↔CAMGE 1,TMP↔GO .+3↔DAC VERT0↔DAC 1,TMP
CALL(L5)↔CAMGE 1,TMP↔GO .+3↔DAC VERT0↔DAC 1,TMP
CALL(L5)↔CAMGE 1,TMP↔GO .+3↔DAC VERT0↔DAC 1,TMP
CALL(L5,VERT0)
SETQ(EDGE2,{MKFE,VERT1,FACE1,VERT3})
MARK 1,DARKEN+NSHARP
NFACE 1,1↔DAC 1,FACE2
CALL(FACOEF↑,FACE2,[0])
;SCAN FACE1'S PERIMETER VERT1 TO VERT3.
HRLOI 377777↔DAC QMIN↔DZM VERT4 ;INIT FOR CLOSEST VIOLATOR.
LAC EDGE2↔DAC EDGE0 ;INIT FOR FACE1 PERIMETER SCAN.
L2: SETQ(EDGE0,{ECCW,EDGE0,FACE1})
SETQ(VERT0,{VCCW,EDGE0,FACE1})
CAMN 1,VERT1↔GO L3
;TEST FOR VERTEX WITHIN THE TRIANGLE THAT WE ARE ABOUT TO LOP.
CALL(WITH3D,FACE2,{XWC(1)},{YWC(1)},{ZWC(1)})
GO L2 ;VERTEX IS NOT WITHIN THE TRIANGLE.
;FIND VERTEX WITHIN TRIANGLE, NEAREST VERT0.
CALL(DISTANCE↑,VERT0,VERT2)
CAML 1,QMIN↔GO L2
DAC 1,QMIN
LAC VERT0↔DAC VERT4
GO L2 ;CONTINUE THE SCAN.
;WHEN TRIANGLE IS UNVIOLATED THEN ITERATE.
L3: SKIPE VERT4↔GO L4
GO MKCVX.
;WHEN TRIANGLE HAS BEEN VIOLATED THEN RECURSE.
L4: CALL(KLFE,EDGE2)
CALL(MKFE,VERT2,FACE1,VERT4)
MARK 1,DARKEN
NFACE 1,1 ;START WORKING ON THE NEW FACE.
CALL(MKCVEX,1)
GO MKCVX. ;CONTINUE WORKING ON THE OLDE FACE.
DECLARE{FACE1,FACE2,TMP,QMIN}
DECLARE{EDGE0,EDGE1,EDGE2,EDGE3}
DECLARE{VERT0,VERT1,VERT2,VERT3,VERT4}
DEL: 0.01
ENDR MKCVEX;3/23/73(BGB)---------------------------------------------
SUBR(ESLURP,BODY) ;REMOVE UNNECESSARY EDGES.
COMMENT ⊗------------------------------------------------------------
⊗
ACCUMULATORS{F1,F2,E1}
;Calculate face co-efficients for each face.
CALL(FACOEF↑,BODY,[-1])
;Go backwords thru ring of edges killing any darkened edges with
;co-planar faces.
MOVE E1,BODY
LOOP: NED E1,E1
TEST E1,EBIT
POP1J
PFACE F1,E1
NFACE F2,E1
;Compare face co-efficients. Since it rans thru numerous FMPR's and
;SQRT we can't expect them to be exactly equal.
FOR @` I ε {XYZ}
< LAC I`WC(F1)
FSBR I`WC(F2)
MOVM 0,0
CAML 0,[0.000001]
GO LOOP
> MOVE 0,E1
;They're co-planar, now the angle on each vertex needs to be checked
;to make sure it's less than π radians.
MARK E1,DARKEN
PVT 1,E1↔DAC 1,V1
NVT 1,E1↔DAC 1,V2
;Do PVT
NCCW 1,E1↔PUSH P,1↔SETQ V3,{OTHER↑,1,V1}
PCW 1,E1 ↔PUSH P,1↔SETQ V4,{OTHER↑,1,V1}
PUSH P,E1
CALL(ANGL3V↑,V3,V1,V2) ;ANGL3V appears to return a value < π
MOVEM 1,T1 ;so both angles must be summed, instead
CALL(ANGL3V↑,V2,V1,V4) ;of just angle between CW and CCW edges.
FADR 1,T1
POP P,E1
CALL DIAGNS,E1
CAML 1,PI↑
GO LOOP
;Do NVT
PCCW 1,E1↔PUSH P,1↔SETQ V3,{OTHER↑,1,V2}
NCW 1,E1 ↔PUSH P,1↔SETQ V4,{OTHER↑,1,V2}
PUSH P,E1
CALL(ANGL3V↑,V3,V2,V1)
MOVEM 1,T1
CALL(ANGL3V↑,V1,V2,V4)
FADR 1,T1
POP P,E1
CALL DIAGNS,E1
CAML 1,PI↑
GO LOOP
;We found an unneeded edge, kill it!
NED 0,E1
PUSH P,0
CALL(KLFE↑,E1)
POP P,E1
GO LOOP+1
DECLARE{V1,V2,V3,V4,T1}
ENDR ESLURP;8/23/73(TVR)---------------------------------------------
;DIAGONOSTIC DISPLAY.
SUBR(DIAGNS,E1,E2,E3)
POP3J
PUSHACS
FDVR 1,PI↑
FMPRI 1,(<180.0>)
PUSH P,1
CALL(DPYSET↑,DPYBUF↑)
CALL(DPYBIG↑,[4])
CALL(AIVECT↑,[-600],[-300])
CALL(DPYSTR↑,[[ASCIZ/Angle = /]])
CALL(FLODPY↑,[3])
CALL(EDPY↑,E1)
CALL(EDPY,E2)
CALL(EDPY,E3)
CALL(DPYOUT↑,[16])
CALL(GEODPY↑)
SNEAKW
CAIE 175
INCHRW
POPACS
POP3J
ENDR DIAGNS;---------------------------------------------------------
XTEST↑: MOVE 1,PDLPTR↑↔PUSH P,(1)↔PUSHJ P,ESLURP
SNEAKW↔CAIN 175↔INCHRW↔UPGIOT 16,[0↔0]↔JCALL GEODPY↑
END